home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
CRS
/
crs04.d81
/
diskcal.prg
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2009-10-10
|
11KB
|
398 lines
10 REM SAVE"@0:DISK CALCULATOR",8
20 PRINT"[147]";
30 POKE53280,0:POKE53281,1
40 DIMD$(512),DN$(512),D(512)
50 DN=8:DN$="":BF=664
60 PRINT"[144][147] CALCULATE A DISK:"
70 PRINT" THIS PROGRAM READS DISK DIRECTORIES"
80 PRINT" AND ALLOWS YOU TO FIND THE MOST"
90 PRINT" EFFICIENT WAY TO SAVE THEM TO OTHER"
100 PRINT" DISKS, LEAVING NO BLOCKS FREE. IT IS"
110 PRINT" SLOW ONLY BECAUSE OF THE IMMENSE NUMBER";
111 PRINT" OF CALCULATIONS THAT MUST BE DONE."
115 GOSUB10023:REM READ DATA
116 PRINT" PRESS RETURN TO START"
117 GETA$:IFA$<>CHR$(13)THEN117
118 GOTO20000
120 PRINT"[147] ADD ENTRIES:"
121 FORNE=1TO512:IFD$(NE)<>""THENNEXTNE
122 PRINT" NUMBER OF ENTRIES:";NE-1:NE=NE-1
125 PRINT" DISK DRIVE DEVICE (7-30) ? ";:I$="8":L=2:GOSUB1130:DN=VAL(I$)
128 PRINT:PRINT" DISK NAME ? ";:I$=DN$:L=4:GOSUB1130:DN$=I$
130 PRINT:PRINT" INPUT QUERY (Y/N) ?";
131 GETA$:IFA$<>"Y"ANDA$<>"N"THEN131
132 QR=0:IFA$="N"THENQR=1
133 PRINTA$
139 PRINT:PRINT" INSERT DISK INTO DRIVE <RETURN>"
140 GETA$:IFA$<>CHR$(13)THEN140
150 GOSUB800
160 RETURN
330 REM SET UP FOR ML
340 PRINT" ONE MOMENT, SETTING UP FOR ML..."
341 GOSUB2300:REM SET UP INDEX(S)
345 A1=51717:A2=51972:A3=52227:A4=52482
346 SX=49152
347 SYS SX+3:REM INITALL
350 FORF=1TONX
360 H1=INT(D(F)/256):L1=D(F)-H1*256
370 H2=INT(D(F+255)/256):L2=D(F+255)-H2*256
380 POKEA1+F,L1
381 POKEA2+F,H1
382 POKEA3+F,L2
383 POKEA4+F,H2
390 NEXTF
410 POKESX+6,N1:POKESX+7,N2
420 POKESX+8,NX
430 H1=INT(B1/256):L1=B1-H1*256
440 POKESX+9,L1:POKESX+10,H1
450 PRINT" ENTERING ML ROUTINE..."
470 SYS SX:REM MAIN
480 A=PEEK(SX+16):PRINTA
485 REM IF A=0 THEN NO MATCH WAS FOUND
490 RETURN
800 REM DIRECTORY READ
801 G1=0
810 PRINT"[147] READING DIRECTORY:"
820 X=0:XX=0
830 OPEN1,DN,0,"$0"
840 GET#1,A$,B$
850 GET#1,A$,A$,A$,B$
860 IF ST<>0 THEN 1060
870 C=0:P$="":P1$=""
880 IF A$<>"" THEN C=ASC(A$)
890 IF B$<>"" THEN C=C+ASC(B$)*256
900 P$="("+MID$(STR$(C),2)+","
910 GET#1,B$:IF ST<>0 THEN 1060
920 IF B$<>CHR$(34) THEN 910
930 GET#1,B$:IFB$<>CHR$(34)THENP1$=P1$+B$:GOTO930
931 NA$=P1$
940 GET#1,B$:IFB$=CHR$(32)THEN940
950 C$=""
960 C$=C$+B$:GET#1,B$:IF B$<>"" THEN 960
970 L=3:IFLEFT$(C$,1)="*"THENL=4
980 P$=P$+LEFT$(C$,L)+")"
990 PD$=LEFT$(C$,L)
1000 IFX=0THEN1020
1010 D$(X+NE)=NA$:D(X+NE)=VAL(MID$(P$,2,3)):DN$(X+NE)=DN$
1020 PRINT"[158]";D(X+NE):PRINT"[145][144]";P1$:PRINT"[145][159]";P$;
1021 IFX=0THENX=1:PRINT:GOTO850
1025 IFX<>0THENGOSUB1112:REM ASK FOR INPUT
1026 PRINT:IFG1=1THENX=X+1:IFX+NE>512THEN1090
1027 IFG1=0THEND(X+NE)=0:D$(X+NE)="":DN$(X+NE)=""
1030 IFX>294THEN1070
1040 IFXX=0THEN850
1050 IFXX=1THEN1090
1060 A=LEN(P$):B=VAL(MID$(P$,2)):P$=LEFT$(P$,A-1)+")"
1070 D$(X+NE)="BLOCKS FREE="+P$
1080 PRINT"[158]";D(X+NE):PRINT"[145][144]";D$(X+NE):D(X+NE)=0:D$(X+NE)=""
1090 CLOSE1
1111 RETURN
1112 REM ASK FOR INPUT
1113 PRINT:PRINT"[145](Y/N)?";
1114 IFQR=1THENA$="Y":GOTO1116
1115 GETA$:IFA$<>"Y"ANDA$<>"N"THEN1115
1116 G1=0:IFA$="Y"THENG1=1:PRINT"Y";
1117 IFG1=0THENPRINT"N";
1118 RETURN
1130 REM INPUT ROUTINE
1140 CL=LEN(I$)
1150 B$="":FORF=1TOL:PRINT"-";:B$=B$+"[157]":NEXTF:PRINTB$;I$;
1160 IFCL<>LTHENPOKE204,0
1170 GET A$:IFA$=""THEN1170
1180 POKE204,1:IFCL<>LTHENPRINT"-[157]";
1190 A=ASC(A$):IFA=34THENPRINTCHR$(34);:POKE212,0:GOTO1250
1200 IFA=20THEN1270
1210 IFA=13THENRETURN
1220 IFA<32ORA>90THEN1160
1230 IFCL>=LTHEN1160
1240 PRINTA$;
1250 I$=I$+A$:CL=LEN(I$)
1260 GOTO1160
1270 IFCL=0THEN1160
1280 I$=LEFT$(I$,CL-1)
1290 CL=LEN(I$):PRINT"[157]-[157]";
1300 GOTO1160
1400 REM DELETE ENTRIES
1401 P=1
1410 PRINT"[147] DELETE ENTRIES:"
1411 PRINT:PRINT"POSITION:";P
1412 PRINT:PRINT
1420 FORF=PTOP+9:PRINTF-P:PRINT"[145]";D$(F)
1421 IFD$(F)=""THEN1423
1422 PRINT"[145](";DN$(F);",";MID$(STR$(D(F)),2);")"
1423 NEXTF
1430 PRINT" F1/F3 NEXT/LAST PAGE, 0-9 TO DELETE"
1431 PRINT" AND SPACE TO EXIT."
1440 GETA$:IFA$=""THEN1440
1450 IFA$=CHR$(133)THENP=P+10:IFP>502THENP=1
1460 IFA$=CHR$(134)THENP=P-10:IFP<1THENP=502
1470 IFA$=CHR$(133)ORA$=CHR$(134)THEN1410
1480 IFA$<"0"ORA$>"9"THEN1491
1490 A=VAL(A$):D(P+A)=0:D$(P+A)="":DN$(P+A)="":GOTO1410
1491 PRINT"[147] PLEASE WAIT, COMPACTING LIST"
1492 J=1:FORF=1TO512
1493 IFD$(F)<>""THEND(J)=D(F):D$(J)=D$(F):DN$(J)=DN$(F)
1494 IFD$(F)<>""THEND(F)=0:D$(F)="":DN$(F)=""
1495 IFD$(J)<>""THENJ=J+1
1496 PRINT"[145] WORKING :";F
1497 NEXTF
1498 RETURN
1500 REM LOAD LIST
1505 PRINT"[147] LOAD LIST:"
1510 PRINT" DISK DRIVE DEVICE (7-30) ? ";:I$="8":L=2:GOSUB1130:DN=VAL(I$)
1515 IFDN<7ORDN>30THENRETURN
1516 PRINT:PRINT" LOAD POSITION (1-10) ? ";:I$="":L=2:GOSUB1130:LP=VAL(I$)
1517 PRINT:PRINT""
1518 IFLP<1ORLP>10THENRETURN
1520 OPEN15,DN,15
1521 NA$="CALCULATE LIST"+STR$(LP)+",S,R"
1525 OPEN2,DN,2,NA$
1526 INPUT#15,A,B$,C,D:IFA=0THEN1540
1530 PRINT"DISK ERROR:":PRINT" ERROR:";A:PRINT" DESCRIPTION:";B$
1531 PRINT" TRACK:";C:PRINT" SECTOR:";D
1532 PRINT" PRESS RETURN"
1533 CLOSE2:CLOSE15
1535 GETA$:IFA$<>CHR$(13)THEN1535
1536 RETURN
1540 FORF=1TO512
1541 INPUT#2,D$(F)
1542 INPUT#2,DN$(F)
1543 INPUT#2,D(F):IFD$(F)="0"THEND$(F)="":DN$(F)="":D(F)=0
1544 PRINT"[145] LOADING :";F
1545 NEXTF
1546 CLOSE2:CLOSE15
1550 RETURN
1600 REM SAVE LIST
1605 PRINT"[147] SAVE LIST:"
1610 PRINT" DISK DRIVE DEVICE (7-30) ? ";:I$="8":L=2:GOSUB1130:DN=VAL(I$)
1615 IFDN<7ORDN>30THENRETURN
1616 PRINT:PRINT" SAVE POSITION (1-10) ? ";:I$="":L=2:GOSUB1130:LP=VAL(I$)
1617 PRINT:PRINT""
1618 IFLP<1ORLP>10THENRETURN
1620 OPEN15,DN,15
1621 NA$="@0:CALCULATE LIST"+STR$(LP)+",S,W"
1625 OPEN2,DN,2,NA$
1626 INPUT#15,A,B$,C,D:IFA=0THEN1640
1630 PRINT"DISK ERROR:":PRINT" ERROR:";A:PRINT" DESCRIPTION:";B$
1631 PRINT" TRACK:";C:PRINT" SECTOR:";D
1632 PRINT" PRESS RETURN"
1633 CLOSE2:CLOSE15
1635 GETA$:IFA$<>CHR$(13)THEN1635
1636 RETURN
1640 FORF=1TO512:IFD$(F)=""THEND$(F)="0":DN$(F)="A":D(F)=1
1641 PRINT#2,D$(F)
1642 PRINT#2,DN$(F)
1643 PRINT#2,D(F):IFD$(F)="0"THEND$(F)="":DN$(F)="":D(F)=0
1644 PRINT"[145] SAVING :";F
1645 NEXTF
1646 CLOSE2:CLOSE15
1650 RETURN
1700 REM SORT LIST
1701 MD=1
1704 IFMD>2THENMD=1
1705 PRINT"[147] SORT LIST:"
1706 PRINT" 1. METHOD : ";:IFMD=1THENPRINT"ALPHABETICAL"
1707 IFMD=2THENPRINT"REVERSE ALPHABETICAL"
1710 PRINT" 2. SORT BY # OF BLOCKS"
1711 PRINT" 3. SORT BY FILE NAME"
1712 PRINT" 4. SORT BY DISK NAME"
1713 PRINT" 5. EXIT"
1714 PRINT" PRESS A NUMBER FROM 1 TO 5."
1715 GETA$:IFA$<"1"ORA$>"5"THEN1715
1718 T=VAL(A$)
1720 IFT=1THENMD=MD+1:GOTO1704
1721 IFT=5THENRETURN
1722 PRINT"[147] SORTING:"
1730 FORNE=1TO512:IFD$(NE)<>""THENNEXTNE
1731 NE=NE-1:PRINT" NUMBER OF RECORDS:";NE:PRINT""
1740 FORA=1TONE-1
1741 PRINT"[145] WORKING:";NE-A
1750 FORB=A+1TONE
1760 IFT=2ANDMD=1THENIFD(A)<D(B)THENGOTO1770
1761 IFT=2ANDMD=2THENIFD(A)>D(B)THENGOTO1770
1762 IFT=3ANDMD=1THENIFD$(A)<D$(B)THENGOTO1770
1763 IFT=3ANDMD=2THENIFD$(A)>D$(B)THENGOTO1770
1764 IFT=4ANDMD=1THENIFDN$(A)<DN$(B)THENGOTO1770
1765 IFT=4ANDMD=2THENIFDN$(A)>DN$(B)THENGOTO1770
1766 A$=D$(A):B$=DN$(A):C=D(A)
1767 D$(A)=D$(B):DN$(A)=DN$(B):D(A)=D(B)
1768 D$(B)=A$:DN$(B)=B$:D(B)=C
1770 NEXTB
1780 NEXTA
1785 RETURN
1800 REM CHANGE # OF BLOCKS TO FIND
1810 PRINT"[147] CHANGE # OF BLOCKS TO FIND:"
1811 I$=MID$(STR$(BF),2)
1820 PRINT" NUMBER OF BLOCKS (100-3160) ? ";:L=5:GOSUB1130:BF=VAL(I$)
1830 IFBF<100ORBF>3160THEN1800
1835 PRINT
1840 RETURN
1900 REM PRINT LIST
1905 PRINT"[147] PRINT LIST:"
1910 PRINT" TURN YOU PRINTER ON-"
1911 PRINT" PRESS RETURN TO PRINT"
1912 PRINT" PRESS SPACE TO EXIT"
1913 GETA$:IFA$<>CHR$(13)ANDA$<>CHR$(32)THEN1913
1914 IFA$=CHR$(32)THENRETURN
1915 OPEN4,4,7
1920 PRINT" PRINTING..."
1925 FORNE=1TO512:IFD$(NE)<>""THENNEXTNE
1926 NE=NE-1
1927 F=1
1928 Q$="[194]LKS [196]ISK [206]AME [201][196] "
1929 PRINT#4,Q$;Q$;Q$
1930 FORJ=FTOF+49
1931 J1=J+50:J2=J+100:IFJ>NETHEN1954
1935 A$=MID$(STR$(D(J)),2):A=LEN(A$)
1936 PRINT#4,A$;:FORB=1TO4-A:PRINT#4," ";:NEXTB
1937 A$=D$(J):A=LEN(A$)
1938 PRINT#4,A$;:FORB=1TO17-A:PRINT#4," ";:NEXTB
1939 A$=DN$(J):A=LEN(A$)
1940 PRINT#4,A$;:FORB=1TO5-A:PRINT#4," ";:NEXTB:IFJ1>NETHEN1953
1941 A$=MID$(STR$(D(J1)),2):A=LEN(A$)
1942 PRINT#4,A$;:FORB=1TO4-A:PRINT#4," ";:NEXTB
1943 A$=D$(J1):A=LEN(A$)
1944 PRINT#4,A$;:FORB=1TO17-A:PRINT#4," ";:NEXTB
1945 A$=DN$(J1):A=LEN(A$)
1946 PRINT#4,A$;:FORB=1TO5-A:PRINT#4," ";:NEXTB:IFJ2>NETHEN1953
1947 A$=MID$(STR$(D(J2)),2):A=LEN(A$)
1948 PRINT#4,A$;:FORB=1TO4-A:PRINT#4," ";:NEXTB
1949 A$=D$(J2):A=LEN(A$)
1950 PRINT#4,A$;:FORB=1TO17-A:PRINT#4," ";:NEXTB
1951 A$=DN$(J2):A=LEN(A$)
1952 PRINT#4,A$;:FORB=1TO5-A:PRINT#4," ";:NEXTB
1953 PRINT#4
1954 NEXTJ
1955 PRINT#4,CHR$(12);:PRINT#4,Q$;Q$;Q$
1960 F=F+150:IFF<NETHEN1930
1965 PRINT#4,CHR$(12);
1970 CLOSE4
1980 RETURN
2000 REM CALCULATE DISKS
2005 D=1
2010 PRINT"[147] CALCULATE DISKS:"
2011 PRINT" THIS USES THE LIST ALREADY IN MEMORY"
2015 PRINT" PRESS RETURN TO START"
2016 PRINT" PRESS SPACE TO ABORT"
2020 GETA$:IFA$<>CHR$(32)ANDA$<>CHR$(13)THEN2020
2021 IFA$=CHR$(32)THENRETURN
2022 PRINT" DEVICE FOR SOLUTION FILE (7-30) ? ";:I$="8":L=2:GOSUB1130:DN=VAL(I$)
2023 OPEN2,DN,2,"@0:SOLUTION,S,W":PRINT#2,"SOLUTION FILE":CLOSE2
2030 PRINT"[147] CALCULATE DISKS:"
2035 TB=0:FORF=1TO512:TB=TB+D(F):NEXTF
2040 PRINT" BLOCK SUM TO SEARCH FOR:";BF
2045 PRINT" TOTAL BLOCKS TO SEARCH FROM:";TB
2047 PRINT" MAX NUMBER OF DISKS:";INT(TB/BF)+1
2048 FORNE=1TO512:IFD$(NE)<>""THENNEXTNE
2049 PRINT" NUMBER OF FILES LEFT:";NE-1
2050 PRINT" DISKS FOUND SO FAR:";D-1
2051 IFTB<BFTHENPRINT" DONE !":GOTO2120
2070 B1=BF
2074 GOSUB330:REM ENTER ML
2080 GOSUB6000:REM WRITE TO OUTPUT FILE
2085 IFA=0THEN2120
2090 REM RID OF OLD FILES
2100 GOSUB1492:PRINT" COMPACTING LIST"
2105 D=D+1
2110 GOTO2030:REM DO IT OVER
2120 REM DUMP LAST TO OUTPUT
2130 OPEN15,DN,15:OPEN2,DN,2,"SOLUTION,A"
2140 PRINT#2,"LAST FILES:"
2150 FORF=1TO512
2160 IFD$(F)<>""THENPRINT#2,D$(F);" ";DN$(F);D(F)
2161 NEXTF
2170 CLOSE2
2180 CLOSE15
2190 PRINT" DUMP SOLUTION TO PRINTER (Y/N) ?"
2195 GETA$:IFA$<>"Y"ANDA$<>"N"THEN2195
2196 IFA$="N"THENEND
2200 OPEN4,4,7
2210 OPEN15,DN,15:OPEN2,DN,2,"SOLUTION,S,R"
2220 GET#2,Z$:S1=ST:IFS1<>0THEN2240
2230 INPUT#2,A$:A$=Z$+A$:PRINT#4,A$:GOTO2220
2240 CLOSE2
2250 CLOSE15
2260 PRINT#4,CHR$(12);CHR$(12);
2270 CLOSE4
2280 END
2300 REM SET UP INDEX(S)
2310 FORNE=1TO512:IFD$(NE)<>""THENNEXTNE
2311 NE=NE-1
2320 B=INT(NE/2):A=NE-B
2321 IFNE>=512THEN2351
2330 FORF=ATO0STEP-1:D$(F+256)=D$(F+B):D(F+256)=D(F+B):DN$(F+256)=DN$(F+B)
2340 D$(F+B)="":DN$(F+B)="":D(F+B)=0
2345 NEXTF
2346 D$(F+256)=D$(1):D(F+256)=D(1):DN$(F+256)=DN$(1)
2347 D$(1)="":DN$(1)="":D(1)=0
2351 FORN1=2TO255:IFD$(N1)<>""THENNEXTN1
2352 FORN2=256TO512:IFD$(N2)<>""THENNEXTN2
2353 N2=N2-255:N1=N1+1
2354 NX=N1:IFN2>NXTHENNX=N2
2360 RETURN
6000 REM SEND SOLUTION TO OUTPUT FILE
6001 GOSUB6070
6010 PRINT" SAVING SOLUTION":OPEN15,DN,15:OPEN2,DN,2,"SOLUTION,A"
6015 PRINT#2," "
6020 PRINT#2,"[196][201][211][203] #";D:FORF=1TON1
6021 IFPEEK(52737+F)=1THENPRINT#2,D$(F);" ";DN$(F);D(F)
6022 IFPEEK(52737+F)=1THEND$(F)="":DN$(F)="":D(F)=0
6030 NEXTF:PRINT"2"
6040 FORF=1TON2
6041 IFPEEK(52992+F)=1THENPRINT#2,D$(F+255);" ";DN$(F+255);D(F+255)
6043 IFPEEK(52992+F)=1THEND$(F+255)="":DN$(F+255)="":D(F+255)=0
6050 NEXTF
6051 PRINT#2,"[212]OTAL :";T
6055 CLOSE2:CLOSE15
6056 PRINT:PRINT
6060 RETURN
6070 T=0:FORF=1TON1:IFPEEK(52737+F)=1THENT=T+D(F):PRINTD$(F);D(F)
6080 NEXTF
6090 FORF=1TON2:IFPEEK(52992+F)=1THENT=T+D(F+255):PRINTD$(F+255);D(F+255)
6100 NEXTF
6105 PRINT"TOTAL:";T
6110 IFT=B1THENRETURN
6140 PRINT" PROBLEM : TOTALS NOT FOUND PROPERLY"
6150 RETURN
10000 DATA76,107,193,76,81,193,0,0,0,0,0,0,0,0,0,0,0
10001 DATA162,255,169,0,157,0,207,202,208,250,96,162,255,169,0,157,1
10002 DATA206,157,0,207,202,208,247,96,162,1,189,1,206,201,0,208,6
10003 DATA169,1,157,1,206,96,169,0,157,1,206,232,236,6,192,176,13
10004 DATA189,1,206,201,1,240,238,169,1,157,1,206,96,169,1,141,15
10005 DATA192,96,162,1,189,0,207,201,0,208,6,169,1,157,0,207,96
10006 DATA169,0,157,0,207,232,236,7,192,176,13,189,0,207,201,1,240
10007 DATA238,169,1,157,0,207,96,169,1,141,15,192,96,173,9,192,141
10008 DATA11,192,173,10,192,141,12,192,169,0,141,13,192,141,14,192,174
10009 DATA8,192,189,1,206,201,1,208,3,32,179,192,189,0,207,201,1
10010 DATA208,3,32,199,192,202,208,233,96,24,189,5,202,109,11,192,141
10011 DATA11,192,189,4,203,109,12,192,141,12,192,96,24,189,3,204,109
10012 DATA13,192,141,13,192,189,2,205,109,14,192,141,14,192,96,173,11
10013 DATA192,205,13,192,208,13,173,12,192,205,14,192,208,5,169,1,141
10014 DATA16,192,96,169,0,141,16,192,141,15,192,32,28,192,32,87,192
10015 DATA173,15,192,201,1,208,1,96,32,132,192,32,219,192,173,16,192
10016 DATA201,1,208,232,96,169,0,141,16,192,141,15,192,32,28,192,32
10017 DATA42,192,32,87,192,173,15,192,201,1,240,14,32,132,192,32,219
10018 DATA192,173,16,192,201,1,208,233,96,32,17,192,169,0,141,15,192
10019 DATA32,42,192,238,32,208,173,15,192,201,1,208,211,96,169,0,162
10020 DATA255,157,5,202,157,4,203,157,3,204,157,2,205,157,1,206,157
10021 DATA0,207,202,208,235,96,32,241,192,173,16,192,201,1,240,3,32
10022 DATA21,193,96
10023 FORF=49152TO49528:READX:POKEF,X:NEXTF:RETURN
20000 REM MAIN MENU
20001 POKE650,128
20010 PRINT" MAIN MENU"
20020 PRINT" 1. ADD ENTRIES"
20030 PRINT" 2. DELETE ENTRIES"
20040 PRINT" 3. LOAD LIST"
20050 PRINT" 4. SAVE LIST"
20060 PRINT" 5. SORT LIST"
20070 PRINT" 6. CHANGE # OF BLOCKS TO FIND"
20080 PRINT" 7. CALCULATE DISKS"
20090 PRINT" 8. PRINT LIST"
20100 PRINT" 9. EXIT"
20110 PRINT" PRESS A NUMBER FROM 1 TO 9."
20111 POKE53281,2
20120 GETA$:IFA$<"1"ORA$>"9"THEN20120
20130 A=VAL(A$):ONAGOSUB120,1400,1500,1600,1700,1800,2000,1900
20140 GOTO20000